home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 23 / AACD 23.iso / AACD / Online / WebYAM / yam.rexx < prev   
OS/2 REXX Batch file  |  2001-02-18  |  31KB  |  933 lines
  1. /*
  2. ** $VER: WebYAM 1.3 (18.2.2001)
  3. ** © 2000-2001 by Jacob Laursen <laursen@myself.com>
  4. **
  5. ** Web browse YAM folders
  6. **
  7. ** Requirements: Apache (or some other web server)
  8. **               YAM 2.3+
  9. **
  10. ** For "quoted printable" -> "8bit" conversion, please download
  11. ** comm/mail/YToolsNG.lha from Aminet and copy the file 'YTCunmime'
  12. ** to the YAM: directory, or correct the path below.
  13. **
  14. ** Version 1.3 - Fixed version check bug.
  15. **             - Sent folders will now have the "To:" name displayed
  16. **               instead of the "From:" name.
  17. **
  18. ** Version 1.2 - Optimized folder scan drastically (YAM 2.2 feature)
  19. **               Added advanced compose mode
  20. **               One more security exploit eliminated
  21. **                 (HTML tags in subject wasn't translated)
  22. **               Signature is no longer added if "Add signature"
  23. **                 is de-selected (work-around for bug in YAM).
  24. **
  25. ** Version 1.1 - Added configuration options
  26. **             - Added URL links in mails
  27. **             - Improved security (exploit eliminated)
  28. **             - Two separators in a row is now supported
  29. **
  30. ** Version 1.0 - Initial release.
  31. **
  32. ** TODO:
  33. ** - Process headers (and don't show irrelevant header lines)
  34. ** - Join "Folders" and "Folders (full)".
  35. */
  36.  
  37. options results
  38. options failat 11
  39.  
  40. /* YAM executable path */
  41. YAMPath = 'YAM:YAM'
  42.  
  43. /* YAM folder file */
  44. Cfg.YAMFolders = 'YAM:.folders'
  45.  
  46. /* WebYAM config file */
  47. Cfg.WebYAM = 'WebYAM.config'
  48.  
  49. /* YTCunmime executable path */
  50. Cfg.UMPath = 'YAM:YTCunmime'
  51.  
  52. /* Misc. appearance options */
  53. Cfg.MsgsPerPage  = 25 /* Number of messages per page            */
  54. Cfg.NumColsQuick =  4 /* Number of columns in quick folder list */
  55. Cfg.NumColsFull  =  2 /* Number of columns in full folder list  */
  56.  
  57. /* Color settings - only RRGGBB values accepted */
  58. Cfg.FldrHdrColor = '333366'
  59. Cfg.BgColor      = 'eeeecc'
  60.  
  61. /* No user-serviceable parts below... */
  62.  
  63.   say 'Content-type: text/html'; say ''
  64.  
  65.   say '<HTML>'; say ''
  66.   say '  <HEAD>'
  67.   say '    <TITLE>Yet Another Mailer - Web Interface</TITLE>'
  68.  
  69.   if ~show('P','YAM') then do
  70.     say '    <META HTTP-EQUIV="Refresh" CONTENT=30>'
  71.     say '  </HEAD>'; say ''
  72.     say '  <BODY BGCOLOR="#ffffff" TEXT="#000000">'
  73.     say '    <P>Please wait, loading YAM...</P>'
  74.     say '  </BODY>'
  75.     say '</HTML>'
  76.     address command 'Run <>NIL: ' || YAMPath || ' HIDE'
  77.     exit
  78.   end
  79.  
  80.   say '  </HEAD>'; say ''
  81.   say '  <BODY BGCOLOR="#ffffff" TEXT="#000000">'
  82.  
  83.   if ~show('L','rexxdossupport.library') then if ~addlib('rexxdossupport.library',0,-30,0) then do
  84.     say '    <P>Error: rexxdossupport.library couldn''t be opened!</P>'
  85.     say '  </BODY>'
  86.     say '</HTML>'
  87.     exit 10
  88.   end
  89.  
  90.   'getvar QUERY_STRING'; query = result
  91.   call ParseConfig
  92.   call ParseArgs(query)
  93.  
  94.   address 'YAM'
  95.  
  96.   /* YAM Version check */
  97.   INFO 'VERSION'
  98.   parse var RESULT '$VER: YAM ' major '.' minor .
  99.   if datatype(minor) ~= 'NUM' then minor = left(minor,1)
  100.   /* Please note that this needs to be fixed in case of revisions > 9 */
  101.  
  102.   if datatype(major) = 'NUM' & datatype(minor) = 'NUM' then do
  103.     if major < 2 | (major = 2 & minor < 3) then do
  104.       say '    <P>YAM 2.3 required (installed version: 'major'.'minor').</P>'
  105.       say '  </BODY>'
  106.       say '</HTML>'
  107.       exit 10
  108.     end
  109.   end
  110.  
  111.   if Arg.Check = 1 then call GetMail
  112.   if Arg.Save  = 1 then call SaveConfig
  113.   if Arg.Help  = 1 then call Help
  114.   else if Arg.Config = 1 then call Config
  115.   else if Arg.Compose = 1 then call ComposeMail
  116.   else if Arg.Send = 1 then call SendMail
  117.   else if Arg.List = 1 then call ListFolders
  118.   else if Arg.Folder > -1 then do
  119.     if Arg.Message > -1 then do
  120.       if Arg.Move = 1 then call MoveMail
  121.       else if Arg.Delete = 1 then call DeleteMail
  122.       else call ReadMessage(Arg.Folder, Arg.Message)
  123.     end
  124.     else do
  125.       if Arg.Move = 1 then call MoveMails(Arg.Folder, Arg.Page)
  126.       else if Arg.Delete = 1 then call DeleteMails(Arg.Folder, Arg.Page)
  127.       else call ListFolder(Arg.Folder, Arg.Page)
  128.     end
  129.   end
  130.   else call ListDeadFolders
  131.  
  132.   say '  </BODY>'
  133.   say '</HTML>'
  134.  
  135. exit
  136.  
  137.  
  138. ParseArgs: PROCEDURE EXPOSE Arg. Cfg.
  139. parse arg string
  140.  
  141.   Arg.List       =  0
  142.   Arg.Check      =  0
  143.   Arg.Config     =  0
  144.   Arg.Help       =  0
  145.   Arg.Compose    =  0
  146.   Arg.Advanced   =  0
  147.   Arg.Send       =  0
  148.   Arg.Save       =  0
  149.   Arg.Signature  =  0
  150.   Arg.Keep       =  1
  151.   Arg.Folder     = -1
  152.   Arg.DestFolder = -1
  153.   Arg.Message    = -1
  154.   Arg.Page       =  1
  155.  
  156.   Arg.Delete     = 0
  157.   Arg.Move       = 0
  158.   Arg.Msgs.COUNT = 0
  159.  
  160.   Arg.From    = ''
  161.   Arg.ReplyTo = ''
  162.   Arg.Cc      = ''
  163.   Arg.Bcc     = ''
  164.  
  165.   query = translate(string, ' ', '&')
  166.   do loop = 1 to words(query)
  167.     arg = word(query,loop)
  168.     if index(arg,'=') > 1 then do
  169.       cmd = left(arg,index(arg,'=')-1)
  170.       parse var arg cmd'='value
  171.       cmd = upper(cmd)
  172.       select
  173.         when cmd = 'FOLDER'     then Arg.Folder     = value
  174.         when cmd = 'DESTFOLDER' then Arg.DestFolder = value
  175.         when cmd = 'MESSAGE'    then Arg.Message    = value
  176.         when cmd = 'PAGE'       then Arg.Page       = value
  177.         when cmd = 'OPTION' & upper(value) = 'DELETE'  then Arg.Delete = 1
  178.         when cmd = 'OPTION' & upper(value) = 'MOVE+TO' then Arg.Move   = 1
  179.         when cmd = 'SEND'   & upper(value) = 'SEND'    then Arg.Send   = 1
  180.         when cmd = 'SAVE'   & upper(value) = 'SAVE'    then Arg.Save   = 1
  181.         when cmd = 'MSGSPERPAGE'  & datatype(value) = 'NUM' then Cfg.MsgsPerPage  = value
  182.         when cmd = 'NUMCOLSQUICK' & datatype(value) = 'NUM' then Cfg.NumColsQuick = value
  183.         when cmd = 'FROM'    then Arg.From      = Convert(value)
  184.         when cmd = 'REPLYTO' then Arg.ReplyTo   = Convert(value)
  185.         when cmd = 'TO'      then Arg.Recipient = Convert(value)
  186.         when cmd = 'CC'      then Arg.Cc        = Convert(value)
  187.         when cmd = 'BCC'     then Arg.Bcc       = Convert(value)
  188.         when cmd = 'SUBJECT' then Arg.Subject   = Convert(value)
  189.         when cmd = 'BODY'    then Arg.Body      = Convert(value)
  190.         when cmd = 'SIGNATURE' & upper(value) = 'ON' then Arg.Signature = 1
  191.         when cmd = 'KEEP' & upper(value) = 'OFF' then Arg.Keep = 0
  192.         when left(cmd,8) = 'MESSAGE.' then do
  193.           parse var arg dummy'.'num'='val
  194.           current = Arg.Msgs.COUNT
  195.           if upper(val) = 'ON' then do
  196.             Arg.Msgs.current = num
  197.             Arg.Msgs.COUNT = current + 1
  198.           end
  199.         end
  200.       end
  201.     end
  202.     else do
  203.       arg = upper(arg)
  204.       if arg = 'LIST'     then Arg.List     = 1
  205.       if arg = 'CHECK'    then Arg.Check    = 1
  206.       if arg = 'CONFIG'   then Arg.Config   = 1
  207.       if arg = 'HELP'     then Arg.Help     = 1
  208.       if arg = 'COMPOSE'  then Arg.Compose  = 1
  209.       if arg = 'ADVANCED' then Arg.Advanced = 1
  210.     end
  211.  
  212.   end
  213.  
  214. return
  215.  
  216.  
  217. ParseConfig: PROCEDURE EXPOSE Cfg.
  218.  
  219.   if ~exists(Cfg.WebYAM) then return
  220.   call open(fh, Cfg.WebYAM, 'R')
  221.  
  222.   do while ~eof(fh)
  223.     line = readln(fh)
  224.     key = upper(word(line, 1))
  225.     arg = word(line, 2)
  226.     if key = 'MSGSPERPAGE' & datatype(arg) = 'NUM' then Cfg.MsgsPerPage = arg
  227.     else if key = 'NUMCOLSQUICK' & datatype(arg) = 'NUM' then Cfg.NumColsQuick = arg
  228.   end
  229.  
  230.   call close(fh)
  231.  
  232. return
  233.  
  234.  
  235. SaveConfig: PROCEDURE EXPOSE Cfg.
  236.  
  237.   call open(fh, Cfg.WebYAM, 'W')
  238.   call writeln(fh, 'MsgsPerPage 'Cfg.MsgsPerPage)
  239.   call writeln(fh, 'NumColsQuick 'Cfg.NumColsQuick)
  240.   call close(fh)
  241.  
  242. return
  243.  
  244.  
  245. ParseFolders: PROCEDURE EXPOSE Cfg.
  246.  
  247.   if ~exists(Cfg.YAMFolders) then return
  248.   call open(fh, Cfg.YAMFolders, 'R')
  249.  
  250.   Cfg.FolderName.COUNT = 0
  251.   do while ~eof(fh)
  252.     line = readln(fh)
  253.     if word(line, 1) = '@FOLDER' then do
  254.       current = Cfg.FolderName.COUNT
  255.       Cfg.FolderName.current = 'F:'right(line,length(line)-8)
  256.       Cfg.FolderName.COUNT = current + 1
  257.     end
  258.     else if word(line, 1) = '@SEPARATOR' then do
  259.       current = Cfg.FolderName.COUNT
  260.       if length(line) > 11 then Cfg.FolderName.current = 'S:'right(line,length(line)-11)
  261.       else Cfg.FolderName.current = 'S:'
  262.       Cfg.FolderName.COUNT = current + 1
  263.     end
  264.   end
  265.  
  266.   call close(fh)
  267.  
  268. return
  269.  
  270.  
  271. GotoMail: PROCEDURE
  272. parse arg num
  273.  
  274.   SETMAIL num
  275.   if RC ~= 10 then return 0
  276.   else say '    <P>This mail does not exist -- please update message list.</P>'
  277.  
  278. return 10
  279.  
  280.  
  281. GotoFolder: PROCEDURE
  282. parse arg num
  283.  
  284.   SETFOLDER num
  285.   if RC ~= 10 then return 0
  286.   else say '    <P>This folder does not exist -- please update folder list.</P>'
  287.  
  288. return 10
  289.  
  290.  
  291. Config: PROCEDURE EXPOSE Cfg.
  292.  
  293.   say '    <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=1 WIDTH="100%">'
  294.   say '      <TR ALIGN="center">'
  295.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?Compose"><B>Compose</B></A></TD>'
  296.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?List&Check"><B>Get mail</B></A></TD>'
  297.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx"><B>Folders</B></A></TD>'
  298.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?List"><B>Folders (full)</B></A></TD>'
  299.   say '        <TD BGCOLOR="#cccc99"><A HREF="yam.rexx?Config"><B>Config</B></A></TD>'
  300.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?Help"><B>Help</B></A></TD>'
  301.   say '      </TR>'
  302.   say '    </TABLE>'
  303.  
  304.   say '    <TABLE BORDER=0 CELLSPACING=5 WIDTH="100%">'
  305.   say '      <TR BGCOLOR="#'Cfg.BgColor'" ALIGN="center">'
  306.   say '        <TD><B>Configuration</B></TD>'
  307.   say '      </TR>'
  308.   say '    </TABLE>'
  309.  
  310.   say '    <FORM NAME="composeform" ACTION="yam.rexx">'
  311.  
  312.   say '    <TABLE BORDER=0 CELLSPACING=0 CELLPADDING=2 WIDTH="100%">'
  313.   say '      <TR><TD COLSPAN=3><HR NOSHADE SIZE=1></TD></TR>'
  314.   say '      <TR VALIGN="top">'
  315.   say '        <TD WIDTH="20%">Messages per Page</TD>'
  316.   say '        <TD><INPUT TYPE="number" NAME="MsgsPerPage" VALUE="'Cfg.MsgsPerPage'"></INPUT></TD>'
  317.   say '      </TR>'
  318.   say '      <TR><TD COLSPAN=3><HR NOSHADE SIZE=1></TD></TR>'
  319.   say '      <TR VALIGN="top">'
  320.   say '        <TD WIDTH="20%">Columns quick</TD>'
  321.   say '        <TD><INPUT TYPE="number" NAME="NumColsQuick" VALUE="'Cfg.NumColsQuick'"></INPUT></TD>'
  322.   say '      </TR>'
  323.   say '    </TABLE>'
  324.  
  325.   say '      <INPUT TYPE="submit" NAME="Save" VALUE="Save">'
  326.  
  327.   say '    </FORM>'
  328.  
  329. return
  330.  
  331.  
  332. ListFolders: PROCEDURE EXPOSE Cfg.
  333.  
  334.   say '    <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=1 WIDTH="100%">'
  335.   say '      <TR ALIGN="center">'
  336.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?Compose"><B>Compose</B></A></TD>'
  337.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?List&Check"><B>Get mail</B></A></TD>'
  338.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx"><B>Folders</B></A></TD>'
  339.   say '        <TD BGCOLOR="#cccc99"><A HREF="yam.rexx?List"><B>Folders (full)</B></A></TD>'
  340.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?Config"><B>Config</B></A></TD>'
  341.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?Help"><B>Help</B></A></TD>'
  342.   say '      </TR>'
  343.   say '    </TABLE>'
  344.  
  345.   say '    <TABLE BORDER=0 CELLSPACING=1 WIDTH="100%">'
  346.   say '      <TR BGCOLOR="#'Cfg.FldrHdrColor'">'
  347.   say '        <TD ALIGN="left"><FONT COLOR="#ffffff"><B>No.</B></FONT></TD>'
  348.   say '        <TD ALIGN="center"><FONT COLOR="#ffffff"><B>Folder</B></FONT></TD>'
  349.   say '        <TD ALIGN="center"><FONT COLOR="#ffffff"><B>Total</B></FONT></TD>'
  350.   say '        <TD ALIGN="center"><FONT COLOR="#ffffff"><B>Unread</B></FONT></TD>'
  351.   say '        <TD ALIGN="center"><FONT COLOR="#ffffff"><B>New</B></FONT></TD>'
  352.   say '      </TR>'
  353.  
  354.   call GoBusy
  355.   USERINFO STEM uinfo.
  356.   do i = 0 to uinfo.FOLDERS-1
  357.     FOLDERINFO i STEM cfi.
  358.     if RC = 10 then iterate
  359.     say '      <TR BGCOLOR="#'Cfg.BgColor'">'
  360.     say '        <TD ALIGN="left">'cfi.NUMBER'</TD>'
  361.     say '        <TD ALIGN="left"><A HREF="yam.rexx?Folder='cfi.NUMBER'">'cfi.NAME'</A></TD>'
  362.     say '        <TD ALIGN="right">'cfi.TOTAL'</TD>'
  363.     say '        <TD ALIGN="right">'cfi.UNREAD'</TD>'
  364.     say '        <TD ALIGN="right">'cfi.NEW'</TD>'
  365.     say '      </TR>'
  366.   end
  367.   APPNOBUSY
  368.  
  369.   say '    </TABLE>'; say
  370.  
  371. return
  372.  
  373.  
  374. ListDeadFolders: PROCEDURE EXPOSE Cfg.
  375.  
  376.   if ~exists(Cfg.YAMFolders) then do
  377.     call ListFolders
  378.     return
  379.   end
  380.  
  381.   say '    <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=1 WIDTH="100%">'
  382.   say '      <TR ALIGN="center">'
  383.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?Compose"><B>Compose</B></A></TD>'
  384.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?Check"><B>Get mail</B></A></TD>'
  385.   say '        <TD BGCOLOR="#cccc99"><A HREF="yam.rexx"><B>Folders</B></A></TD>'
  386.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?List"><B>Folders (full)</B></A></TD>'
  387.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?Config"><B>Config</B></A></TD>'
  388.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?Help"><B>Help</B></A></TD>'
  389.   say '      </TR>'
  390.   say '    </TABLE>'
  391.  
  392.   call ParseFolders
  393.  
  394.   say '    <TABLE BORDER=0 CELLSPACING=1 WIDTH="100%">'
  395.   say '      <TR BGCOLOR="#'Cfg.FldrHdrColor'">'
  396.   do loop = 0 to Cfg.NumColsQuick-1
  397.     say '        <TD><FONT COLOR="#ffffff"><B>No.</B></FONT></TD>'
  398.     say '        <TD ALIGN="center"><FONT COLOR="#ffffff"><B>Folder</B></FONT></TD>'
  399.   end
  400.   say '      </TR>'
  401.  
  402.   step = Cfg.FolderName.COUNT/Cfg.NumColsQuick
  403.   if trunc(step) ~= step then step = trunc(step)+1
  404.  
  405.   do mainloop = 0 to step-1
  406.     say '      <TR BGCOLOR="#'Cfg.BgColor'">'
  407.     do loop = 0 to Cfg.NumColsQuick-1
  408.       current = mainloop+loop*step
  409.       if current > Cfg.FolderName.COUNT-1 then leave
  410.       if left(cfg.FolderName.current, 2) = 'F:' then do
  411.         say '        <TD>'current'</TD>'
  412.         say '        <TD><A HREF="yam.rexx?Folder='current'">'right(cfg.FolderName.current, length(cfg.FolderName.current)-2)'</A></TD>'
  413.       end
  414.     end
  415.     say '      </TR>'
  416.   end
  417.  
  418.   say '    </TABLE>'; say
  419.  
  420. return
  421.  
  422.  
  423. DeleteMail: PROCEDURE EXPOSE Arg. Cfg.
  424.  
  425.   Arg.Msgs.COUNT = 1
  426.   Arg.Msgs.0 = Arg.Message
  427.   call DeleteMails(Arg.Folder, Arg.Page)
  428.  
  429. return
  430.  
  431.  
  432. DeleteMails: PROCEDURE EXPOSE Arg. Cfg.
  433. parse arg folder, page
  434.  
  435.   call GoBusy
  436.   RC = GotoFolder(folder)
  437.   if RC = 10 then do
  438.     APPNOBUSY
  439.     return
  440.   end
  441.  
  442.   do loop=Arg.Msgs.COUNT-1 to 0 by -1
  443.     RC = GotoMail(Arg.Msgs.loop)
  444.     if RC = 10 then leave
  445.     MAILDELETE 'FORCE'
  446.   end
  447.   APPNOBUSY
  448.  
  449.   call ListFolder(folder, page)
  450.  
  451. return
  452.  
  453.  
  454. MoveMail: PROCEDURE EXPOSE Arg. Cfg.
  455.  
  456.   Arg.Msgs.COUNT = 1
  457.   Arg.Msgs.0 = Arg.Message
  458.   call MoveMails(Arg.Folder, Arg.Page)
  459.  
  460. return
  461.  
  462.  
  463. MoveMails: PROCEDURE EXPOSE Arg. Cfg.
  464. parse arg folder, page
  465.  
  466.   call GoBusy
  467.   RC = GotoFolder(folder)
  468.   if RC = 10 then do
  469.     APPNOBUSY
  470.     return
  471.   end
  472.  
  473.   do loop=Arg.Msgs.COUNT-1 to 0 by -1
  474.     RC = GotoMail(Arg.Msgs.loop)
  475.     if RC = 10 then leave
  476.     MAILMOVE Arg.DestFolder
  477.   end
  478.   APPNOBUSY
  479.  
  480.   call ListFolder(folder, page)
  481.  
  482. return
  483.  
  484.  
  485. ListFolder: PROCEDURE EXPOSE Cfg.
  486. parse arg folder, page
  487.  
  488.   call ParseFolders
  489.   call GoBusy
  490.  
  491.   RC = GotoFolder(folder)
  492.   if RC = 10 then do
  493.     APPNOBUSY
  494.     return
  495.   end
  496.  
  497.   FOLDERINFO STEM fi.
  498.  
  499.   start = Cfg.MsgsPerPage * (page-1)
  500.   end   = Cfg.MsgsPerPage * page
  501.   if end > fi.TOTAL then end = fi.TOTAL
  502.   pages = trunc((fi.TOTAL-1)/Cfg.MsgsPerPage)+1
  503.  
  504.   say '    <FORM NAME="WebYAM" ACTION="yam.rexx">'
  505.   say '      <INPUT TYPE="hidden" NAME="Folder" VALUE="'folder'">'
  506.   say '      <INPUT TYPE="hidden" NAME="Page" VALUE="'page'">'
  507.  
  508.   say '      <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=1 WIDTH="100%">'
  509.   say '        <TR>'
  510.   say '          <TD COLSPAN=1 ALIGN="left"><FONT SIZE=+2><B>Folder: 'right(Cfg.FolderName.folder, length(Cfg.FolderName.folder)-2)'</B></FONT></TD>'
  511.   pageinfo = '        <TD COLSPAN=4 ALIGN="right">Page 'page' of 'pages' ['
  512.   do loop = 1 to pages
  513.     if loop = page then pageinfo = pageinfo' 'loop
  514.     else pageinfo = pageinfo' <A HREF="yam.rexx?Folder='folder'&Page='loop'">'loop'</A>'
  515.   end
  516.   say pageinfo' ]</TD>'
  517.  
  518.   say '        <TR ALIGN="center">'
  519.   say '          <TD BGCOLOR="#336699"><A HREF="yam.rexx?Compose"><B>Compose</B></A></TD>'
  520.   say '          <TD BGCOLOR="#336699"><A HREF="yam.rexx?Folder='folder'&check"><B>Get mail</B></A></TD>'
  521.   say '          <TD BGCOLOR="#336699"><A HREF="yam.rexx"><B>Folders</B></A></TD>'
  522.   say '          <TD BGCOLOR="#336699"><A HREF="yam.rexx?List"><B>Folders (full)</B></A></TD>'
  523.   say '          <TD BGCOLOR="#336699"><A HREF="yam.rexx?Config"><B>Config</B></A></TD>'
  524.   say '          <TD BGCOLOR="#336699"><A HREF="yam.rexx?Help"><B>Help</B></A></TD>'
  525.   say '        </TR>'
  526.   say '      </TABLE>'
  527.  
  528.   say '      <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=1 WIDTH="100%">'
  529.   say '        <TR BGCOLOR="#'Cfg.FldrHdrColor'">'
  530.   say '          <TD><IMG SRC="pics/newmail.gif" WIDTH=11 HEIGHT=11 ALT="New" HSPACE=5></TD>'
  531.   say '          <TD HEIGHT=23> </TD>'
  532.   say '          <TD ALIGN="left"> <FONT COLOR="#ffffff"><B>No.</B></FONT></TD>'
  533.   say '          <TD ALIGN="center"><FONT COLOR="#ffffff"><B>Name</B></FONT></TD>'
  534.   say '          <TD ALIGN="center"><FONT COLOR="#ffffff"><B>Subject</B></FONT></TD>'
  535.   say '          <TD ALIGN="center"><FONT COLOR="#ffffff"><B>Date</B></FONT></TD>'
  536.   say '          <TD ALIGN="center"><FONT COLOR="#ffffff"><B>Size</B></FONT></TD>'
  537.   say '          <TD ALIGN="right"><FONT COLOR="#ffffff"><B>Flags</B></FONT> </TD>'
  538.   say '        </TR>'
  539.  
  540.   do loop = start to end-1
  541.     MAILINFO loop STEM sel.
  542.  
  543.     if fi.TYPE = 3 | fi.TYPE = 6 then name = sel.TO
  544.     else name = sel.FROM
  545.     if index(name,'<') ~= 0 then email = left(name,index(name,'<')-2)
  546.     else email = name
  547.  
  548.     subj = Replace(sel.SUBJECT, '<', '<')
  549.     subj = Replace(subj, '>', '>')
  550.  
  551.     say '        <TR BGCOLOR="#'Cfg.BgColor'">'
  552.  
  553.     if sel.STATUS = 'U' | sel.STATUS = 'N' then say '         <TD><IMG SRC="pics/newmail.gif" WIDTH=11 HEIGHT=11 ALT="New" HSPACE=5></TD>'
  554.     else say '         <TD> </TD>'
  555.  
  556.     say '          <TD><INPUT TYPE="checkbox" NAME="Message.'loop'"></TD>'
  557.  
  558.     say '          <TD ALIGN="left" NOWRAP> 'sel.INDEX+1'</TD>'
  559.     estr = '          <TD ALIGN="left" NOWRAP> '
  560.     if left(sel.FLAGS,1) = 'M' then estr = estr'<IMG SRC="pics/status_group.gif" WIDTH=19 HEIGHT=9 ALT="M"> '
  561.     estr = estr'<A HREF="yam.rexx?Folder='folder'&Message='sel.INDEX'">'email'</A></TD>'
  562.     say estr
  563.     say '          <TD ALIGN="left" NOWRAP> 'subj'</TD>'
  564.     say '          <TD ALIGN="left" NOWRAP> 'sel.DATE'</TD>'
  565.     say '          <TD ALIGN="right" NOWRAP>'sel.SIZE' </TD>'
  566.  
  567.     imgstat = '          <TD ALIGN="right" NOWRAP>'
  568.     if substr(sel.FLAGS,2,1) = 'A' then imgstat = imgstat'<IMG SRC="pics/status_attach.gif" WIDTH=9 HEIGHT=10 ALT="A"> '
  569.     if substr(sel.FLAGS,3,1) = 'R' then imgstat = imgstat'<IMG SRC="pics/status_report.gif" WIDTH=6 HEIGHT=10 ALT="R"> '
  570.     if substr(sel.FLAGS,4,1) = 'C' then imgstat = imgstat'<IMG SRC="pics/status_crypt.gif" WIDTH=6 HEIGHT=9 ALT="C"> '
  571.     if substr(sel.FLAGS,5,1) = 'S' then imgstat = imgstat'<IMG SRC="pics/status_signed.gif" WIDTH=6 HEIGHT=9 ALT="S"> '
  572.     if sel.STATUS = 'O' then imgstat = imgstat'<IMG SRC="pics/status_old.gif" WIDTH=25 HEIGHT=10 ALT="O">'
  573.     else if sel.STATUS = 'N' then imgstat = imgstat'<IMG SRC="pics/status_new.gif" WIDTH=25 HEIGHT=10 ALT="N">'
  574.     else if sel.STATUS = 'R' then imgstat = imgstat'<IMG SRC="pics/status_reply.gif" WIDTH=25 HEIGHT=10 ALT="R">'
  575.     else if sel.STATUS = 'U' then imgstat = imgstat'<IMG SRC="pics/status_unread.gif" WIDTH=25 HEIGHT=10 ALT="U">'
  576.     else if sel.STATUS = 'F' then imgstat = imgstat'<IMG SRC="pics/status_forward.gif" WIDTH=25 HEIGHT=10 ALT="F">'
  577.     else if sel.STATUS = 'S' then imgstat = imgstat'<IMG SRC="pics/status_sent.gif" WIDTH=25 HEIGHT=10 ALT="S">'
  578.     else if sel.STATUS = 'W' then imgstat = imgstat'<IMG SRC="pics/status_waitsend.gif" WIDTH=25 HEIGHT=10 ALT="W">'
  579.     else if sel.STATUS = 'H' then imgstat = imgstat'<IMG SRC="pics/status_hold.gif" WIDTH=25 HEIGHT=10 ALT="H">'
  580.     else if sel.STATUS = 'E' then imgstat = imgstat'<IMG SRC="pics/status_error.gif" WIDTH=25 HEIGHT=10 ALT="E">'
  581.     say imgstat' </TD>'
  582.     say '        </TR>'
  583.   end
  584.  
  585.   APPNOBUSY
  586.  
  587.   say '        <TR><TD HEIGHT=12></TD></TR>'
  588.   say '        <TR>'
  589.   temp = '          <TD VALIGN="top" ALIGN="right" COLSPAN=8> [ '
  590.   if page = 1 then temp = temp'Prev Page'
  591.   else temp = temp'<A HREF="yam.rexx?Folder='folder'&Page='page-1'">Prev Page</A>'
  592.   temp = temp' | '
  593.   if page = pages then temp = temp'Next Page'
  594.   else temp = temp'<A HREF="yam.rexx?Folder='folder'&Page='page+1'">Next Page</A>'
  595.   say temp' ]</TD>'
  596.   say '        </TR>'
  597.   say '      </TABLE>'; say
  598.  
  599.   call MakeMoveTo(folder)
  600.  
  601.   say '    </FORM>'
  602.  
  603. return
  604.  
  605.  
  606. ReadMessage: PROCEDURE EXPOSE Cfg.
  607. parse arg folder, message
  608.  
  609.   call GoBusy
  610.   RC = GotoFolder(folder)
  611.   if RC = 10 then do
  612.     APPNOBUSY
  613.     return
  614.   end
  615.  
  616.   RC = GotoMail(message)
  617.   if RC = 10 then do
  618.     APPNOBUSY
  619.     return
  620.   end
  621.  
  622.   call ParseFolders
  623.   FOLDERINFO STEM cfi.
  624.  
  625.   say '    <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=1 WIDTH="100%">'
  626.   say '      <TR ALIGN="center">'
  627.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?Compose"><B>Compose</B></A></TD>'
  628.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?Folder='folder'&Message='message'&Check"><B>Get mail</B></A></TD>'
  629.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?Folder='folder'"><B>'cfi.NAME'</B></A></TD>'
  630.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx"><B>Folders</B></A></TD>'
  631.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?List"><B>Folders (full)</B></A></TD>'
  632.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?Config"><B>Config</B></A></TD>'
  633.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?Help"><B>Help</B></A></TD>'
  634.   say '      </TR>'
  635.   say '    </TABLE>'
  636.  
  637.   MAILEXPORT 'T:YAM-TextMode.tmp'
  638.   if exists(Cfg.UMPath) = 1 then address command Cfg.UMPath || ' MAIL=T:YAM-TextMode.tmp'
  639.   say '    <PRE>'
  640.  
  641.   call open(fh, 'T:YAM-TextMode.tmp', 'R')
  642.   do while ~eof(fh)
  643.     line = readln(fh)
  644.     if line = '-- ' then say '<HR>'
  645.     else do
  646.       line = Replace(line, '<', '<')
  647.       line = Replace(line, '>', '>')
  648.       say LinkURL(line)
  649.     end
  650.   end
  651.  
  652.   call close(fh)
  653.  
  654.   say '    </PRE>'
  655.   address command 'Delete >NIL: T:YAM-TextMode.tmp'
  656.  
  657.   MAILINFO STEM sel.
  658.   if sel.STATUS = 'N' | sel.STATUS = 'U' then MAILSTATUS 'O'
  659.  
  660.   APPNOBUSY
  661.   say '    <FORM NAME="WebYAM" ACTION="yam.rexx">'
  662.   say '      <INPUT TYPE="hidden" NAME="Folder" VALUE="'folder'">'
  663.   say '      <INPUT TYPE="hidden" NAME="Message" VALUE="'message'">'
  664.   call ParseFolders
  665.   call MakeMoveTo(folder)
  666.   say '    </FORM'
  667.  
  668. return
  669.  
  670.  
  671. GetMail: PROCEDURE
  672.  
  673.   MAILCHECK
  674.  
  675. return
  676.  
  677.  
  678. ComposeMail: PROCEDURE EXPOSE Arg.
  679.  
  680.   say '    <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=1 WIDTH="100%">'
  681.   say '      <TR ALIGN="center">'
  682.   say '        <TD BGCOLOR="#cccc99"><A HREF="yam.rexx?Compose"><B>Compose</B></A></TD>'
  683.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?Compose&Check"><B>Get mail</B></A></TD>'
  684.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx"><B>Folders</B></A></TD>'
  685.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?List"><B>Folders (full)</B></A></TD>'
  686.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?Config"><B>Config</B></A></TD>'
  687.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?Help"><B>Help</B></A></TD>'
  688.   say '      </TR>'
  689.   say '    </TABLE>'
  690.  
  691.   say '    <FORM NAME="composeform" ACTION="yam.rexx">'
  692.   say '      <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0>'
  693.   say '        <TR VALIGN="top">'
  694.   say '          <TD COLSPAN=2 ALIGN="center">'
  695.   say '            <INPUT TYPE="submit" NAME="Send" VALUE="Send">'
  696.   say '            <INPUT TYPE="submit" NAME="Cancel" VALUE="Cancel">'
  697.   if Arg.Advanced = 0 then
  698.     say '            <A HREF="yam.rexx?Compose&Advanced">Advanced</A>'
  699.   else
  700.     say '            <A HREF="yam.rexx?Compose">Simple</A>'
  701.   say '          </TD>'
  702.   say '        </TR>'
  703.  
  704.   if Arg.Advanced = 1 then do
  705.     say '        <TR>'
  706.     say '          <TD ALIGN="right" NOWRAP><B>From:</B></TD>'
  707.     say '          <TD ALIGN="left"><INPUT TYPE="text" NAME="From" VALUE="" SIZE=65 MAXLENGTH=1000</TD>'
  708.     say '        </TR>'
  709.     say '        <TR>'
  710.     say '          <TD ALIGN="right" NOWRAP><B>Reply-To:</B></TD>'
  711.     say '          <TD ALIGN="left"><INPUT TYPE="text" NAME="ReplyTo" VALUE="" SIZE=65 MAXLENGTH=1000</TD>'
  712.     say '        </TR>'
  713.   end
  714.  
  715.   say '        <TR>'
  716.   say '          <TD ALIGN="right" NOWRAP><B>To:</B></TD>'
  717.   say '          <TD ALIGN="left"><INPUT TYPE="text" NAME="To" VALUE="" SIZE=65 MAXLENGTH=1000</TD>'
  718.   say '        </TR>'
  719.   say '        <TR>'
  720.   say '          <TD ALIGN="right" NOWRAP><B>Cc:</B></TD>'
  721.   say '          <TD ALIGN="left"><INPUT TYPE="text" NAME="Cc" VALUE="" SIZE=65 MAXLENGTH=1000</TD>'
  722.   say '        </TR>'
  723.  
  724.   if Arg.Advanced = 1 then do
  725.     say '        <TR>'
  726.     say '          <TD ALIGN="right" NOWRAP><B>Bcc:</B></TD>'
  727.     say '          <TD ALIGN="left"><INPUT TYPE="text" NAME="Bcc" VALUE="" SIZE=65 MAXLENGTH=1000</TD>'
  728.     say '        </TR>'
  729.   end
  730.  
  731.   say '        <TR>'
  732.   say '          <TD ALIGN="right" NOWRAP><B>Subject:</B></TD>'
  733.   say '          <TD ALIGN="left"><INPUT TYPE="text" NAME="Subject" VALUE="" SIZE=65 MAXLENGTH=80</TD>'
  734.   say '        </TR>'
  735.   say '        <TR>'
  736.   say '          <TD></TD>'
  737.   say '          <TD HEIGHT=30 VALIGN="middle">'
  738.   say '            <INPUT TYPE="checkbox" NAME="Signature" VALUE="on">Add signature'
  739.   say '            <INPUT TYPE="checkbox" NAME="Keep" VALUE="off">Delete when sent'
  740.   say '          </TD>'
  741.   say '        </TR>'
  742.   say '      </TABLE>'
  743.   say '      <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0>'
  744.   say '        <TR>'
  745.   say '          <TD ALIGN="center">'
  746.   say '            <TEXTAREA NAME="Body" ROWS=30 COLS=74 WRAP="soft"></TEXTAREA>'
  747.   say '          </TD>'
  748.   say '        </TR>'
  749.   say '      </TABLE>'
  750.   say '    </FORM>'
  751.  
  752. return
  753.  
  754.  
  755. SendMail: PROCEDURE EXPOSE Arg.
  756.  
  757.   call open(fh, 'T:WebYAM-write.tmp', 'W')
  758.   call writeln(fh, Arg.body)
  759.   call close(fh)
  760.  
  761.   call GoBusy
  762.  
  763.   'MAILWRITE QUIET'
  764.  
  765.   WRITETO '"'Arg.Recipient'"'
  766.   if Arg.From    ~= '' then WRITEFROM '"'Arg.From'"'
  767.   if Arg.ReplyTo ~= '' then WRITEREPLYTO '"'Arg.ReplyTo'"'
  768.   if Arg.Cc      ~= '' then WRITECC '"'Arg.Cc'"'
  769.   if Arg.Bcc     ~= '' then WRITEBCC '"'Arg.Bcc'"'
  770.   WRITESUBJECT '"'Arg.Subject'"'
  771.  
  772.   if Arg.Signature = 0 then WRITELETTER 'T:WebYAM-write.tmp' NOSIG
  773.   else WRITELETTER 'T:WebYAM-write.tmp'
  774.  
  775.   if Arg.Keep = 0 then 'WRITEOPTIONS DELETE'
  776.   else WRITEOPTIONS
  777.  
  778.   WRITESEND
  779.  
  780.   APPNOBUSY
  781.   address command 'Delete >NIL: T:WebYAM-write.tmp'
  782.  
  783.   say '    <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=1 WIDTH="100%">'
  784.   say '      <TR ALIGN="center">'
  785.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?Compose"><B>Compose</B></A></TD>'
  786.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?Check"><B>Get mail</B></A></TD>'
  787.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx"><B>Folders</B></A></TD>'
  788.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?List"><B>Folders (full)</B></A></TD>'
  789.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?Config"><B>Config</B></A></TD>'
  790.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?Help"><B>Help</B></A></TD>'
  791.   say '      </TR>'
  792.   say '    </TABLE>'
  793.   say '    <BR>'
  794.   say '    <H2>Your mail was succesfully sent.</H2>'
  795.  
  796. return
  797.  
  798.  
  799. Help: PROCEDURE
  800.  
  801.   say '    <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=1 WIDTH="100%">'
  802.   say '      <TR ALIGN="center">'
  803.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?Compose"><B>Compose</B></A></TD>'
  804.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?Help&Check"><B>Get mail</B></A></TD>'
  805.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx"><B>Folders</B></A></TD>'
  806.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?List"><B>Folders (full)</B></A></TD>'
  807.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?Config"><B>Config</B></A></TD>'
  808.   say '        <TD BGCOLOR="#cccc99"><A HREF="yam.rexx?Help"><B>Help</B></A></TD>'
  809.   say '      </TR>'
  810.   say '    </TABLE>'
  811.   say '    <BR>'
  812.  
  813.   say '    <H1>WebYAM 1.3 by Jacob Laursen</H1>'; say
  814.   say '    <P>Browse your YAM folders through the World Wide Web.</P>'
  815.   say '    <P>'
  816.   say '      Author''s e-mail address: <A HREF="mailto:laursen@myself.com">laursen@myself.com</A><BR>'
  817.   say '      WebYAM homepage: <A HREF="http://home.worldonline.dk/~jlaur/amiga/webyam/">http://home.worldonline.dk/~jlaur/amiga/webyam/</A><BR>'
  818.   say '      Status icons by Ash Thomas'
  819.   say '    </P>'; say
  820.  
  821.   say '    <H1>YAM information</H1>'; say
  822.   say '    <UL>'
  823.   INFO 'AUTHOR'
  824.   say '      <LI>Author: 'RESULT
  825.   INFO 'VERSION'
  826.   parse var RESULT '$VER: YAM ' ver .
  827.   say '      <LI>Version (running on this server): 'ver
  828.   say '      <LI>Website: <A HREF="http://www.yam.ch/">http://www.yam.ch</A>'
  829.   say '      <LI>Development team: Emmanuel Lesueur, Jörg Strohmayer, Jacob Laursen, Marcel Beck, Matthias Bethke, Peter Hans van den Muijzenberg, Nico Schottelius'
  830.   say '      <LI>Development homepage: <A HREF="http://www.sourceforge.net/projects/yamos/">http://yamos.sourceforge.net</A>'
  831.   say '    </UL>'
  832.  
  833. return
  834.  
  835.  
  836. Convert: PROCEDURE
  837. parse arg dummy
  838.  
  839.   dummy = translate(dummy, ' ', '+')
  840.   do until pos=0
  841.     pos=index(dummy,'%')
  842.     if pos>0 then do
  843.       hex=substr(dummy,pos+1,2)
  844.       char=x2c(hex)
  845.       if pos=1 then dummy=char||substr(dummy,pos+3)
  846.       if pos>1 & pos<length(dummy)-2 then dummy=left(dummy,pos-1)||char||substr(dummy,pos+3)
  847.       if pos=length(dummy)-2 then dummy=left(dummy,pos-1)||char
  848.     end
  849.   end
  850.  
  851. return dummy
  852.  
  853.  
  854. GoBusy: PROCEDURE
  855.  
  856.   APPBUSY 'TEXT="WebYAM is working, please wait..."'
  857.  
  858. return
  859.  
  860.  
  861. MakeMoveTo: PROCEDURE EXPOSE Cfg.
  862. parse arg folder
  863.  
  864.   say '      <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0>'
  865.   say '        <TR>'
  866.   say '          <TD ALIGN="center"><INPUT TYPE="submit" NAME="Option" VALUE="Move to"></TD>'
  867.   say '          <TD ALIGN="left" COLSPAN=2><SELECT NAME="DestFolder">'
  868.   do loop = 0 to Cfg.FolderName.COUNT-1
  869.     if loop = folder then iterate
  870.     if left(Cfg.FolderName.loop, 2) = 'F:' then say '            <OPTION VALUE="'loop'">'right(Cfg.FolderName.loop,length(Cfg.FolderName.loop)-2)
  871.   end
  872.   say '          </SELECT></TD>'
  873.   say '        </TR>'
  874.   say '        <TR>'
  875.   say '          <TD ALIGN="center"><INPUT TYPE="submit" NAME="Option" VALUE="Delete"></TD>'
  876.   say '        </TR>'
  877.   say '      </TABLE>'
  878.  
  879. return
  880.  
  881.  
  882. Replace: PROCEDURE
  883. parse arg String,Old,New
  884.  
  885.   do while index(String,Old) ~= 0
  886.     interpret "parse var String left '"Old"' right"
  887.     String = left || New || right
  888.   end
  889.  
  890. return String
  891.  
  892.  
  893. LinkURL: PROCEDURE
  894. parse arg line
  895.  
  896.   p = index(line, 'http://')
  897.   q = index(line, 'www')
  898.  
  899.   if p ~= 0 | q ~= 0 then do
  900.     if p = 0 | (p > q & q > 0) then p = q
  901.  
  902.     len = length(line)
  903.     l = left(line, p-1)
  904.  
  905.     /* URL start position: len-p+1 */
  906.  
  907.     url = right(line, len-p+1)
  908.     /* This is the URL followed by the rest of the line */
  909.  
  910.     parse var url url .
  911.     /* Cut what we know for sure is not a part of the URL */
  912.  
  913.     i = length(url)
  914.     c = substr(url, i, 1)
  915.     do while ~datatype(c, 'ALPHANUMERIC') & c ~= '/' & i > 1
  916.       i = i - 1
  917.       c = substr(url, i, 1)
  918.     end
  919.     if i > 1 then url = left(url, i)
  920.     else url = ''
  921.  
  922.     r = right(line, length(line)-length(url)-p+1)
  923.  
  924.     if left(url, 7) ~= 'http://' then ref = 'http://' || url
  925.     else ref = url
  926.  
  927.     return l || '<A HREF="' || ref || '">' || url || '</A>' || LinkURL(r)
  928.     /* Recurse until all references have been made */
  929.  
  930.   end
  931.  
  932. return line
  933.